home *** CD-ROM | disk | FTP | other *** search
/ The PC-SIG Library 10 / The PC-Sig Library - Shareware for the IBM PC and Compatibles (PC-SIG)(Tenth Edition Disks 1-2804)(1991).iso / PC_SIGCD / 00 / 2 / DISK0028.ZIP / GRAFGE.BAS < prev    next >
BASIC Source File  |  1983-03-05  |  8KB  |  307 lines

  1. 1 '      *************
  2. 2 '      ** GRAFGEN **
  3. 3 '      *************
  4. 4 '
  5. 5 '      by Wes Meier
  6. 6 '      230 B Park Lake Circle
  7. 7 '      Walnut Creek, CA 94598
  8. 8 '
  9. 9 '      June/July 1982
  10. 10 '
  11. 11 '     Requires Color Adapter, BASICA,
  12. 12 '     and, optionally, IBM or Epson
  13. 13 '     (MX-80 or MX-100) equipped with
  14. 14 '     the GRAFTRAX ROMs.
  15. 15 '
  16. 16 KEY OFF
  17. 17 WIDTH 40
  18. 18 SCREEN 1,0
  19. 19 COLOR 1,0
  20. 20 DEFINT A-Z
  21. 21 DIM GRID (700),REDBOX (20), YELLOWBOX (17)
  22. 22 CLS
  23. 23 DEF FNGC(G,C)=(G-128)*8+C
  24. 24 DEF FNEXC(C)=2^(7-C)
  25. 25 Q$=CHR$(34)' Quote Marks
  26. 26 ' Set up graphics grid.
  27. 27 FOR X=0 TO 73 STEP 9
  28. 28 LINE (X,0)-(X,72),1
  29. 29 NEXT
  30. 30 FOR Y= 0 TO 73 STEP 9
  31. 31 LINE (0,Y)-(72,Y),1
  32. 32 NEXT
  33. 33 GET (0,0)-(72,72),GRID
  34. 34 CLS
  35. 35 ' Set up cursor.
  36. 36 LINE (2,2)-(7,7),2,BF
  37. 37 GET (1,1)-(8,8),REDBOX
  38. 38 CLS
  39. 39 ' Set up graphics block.
  40. 40 LINE (1,1)-(8,8),3,BF
  41. 41 GET (1,1)-(8,8),YELLOWBOX
  42. 42 GOSUB 45
  43. 43 GOTO 225
  44. 44 ' Set up Main Menu Key Vectors.
  45. 45 ON KEY(1) GOSUB 66
  46. 46 ON KEY(2) GOSUB 73
  47. 47 ON KEY(3) GOSUB 80
  48. 48 ON KEY(4) GOSUB 86
  49. 49 ON KEY(5) GOSUB 89
  50. 50 ON KEY(6) GOSUB 100
  51. 51 ON KEY(7) GOSUB 97
  52. 52 ON KEY(8) GOSUB 108
  53. 53 ON KEY(9) GOSUB 111
  54. 54 ON KEY(10) GOSUB 122
  55. 55 ON KEY(11) GOSUB 199
  56. 56 ON KEY(12) GOSUB 209
  57. 57 ON KEY(13) GOSUB 214
  58. 58 ON KEY(14) GOSUB 219
  59. 59 ' Turn on Key Trapping.
  60. 60 FOR X=1 TO 14
  61. 61 KEY (X) ON
  62. 62 NEXT
  63. 63 RETURN
  64. 64 ' Main Menu Key Subroutines
  65. 65 ' F1 Sub. Set Block.
  66. 66 T=PEEK(FNGC(GN,ROW))
  67. 67 IF T AND FNEXC(COL) THEN 71' Block already set.
  68. 68 PUT (COL*9+1,ROW*9+1),YELLOWBOX,PSET'Set block.
  69. 69 T=T+FNEXC(COL)
  70. 70 POKE(FNGC(GN,ROW)),T'Put it in memory.
  71. 71 RETURN
  72. 72 ' F2 Sub. Reset block.
  73. 73 T=PEEK(FNGC(GN,ROW))
  74. 74 IF (T AND FNEXC(COL))=0 THEN 71' Cell not set. Return.
  75. 75 PUT (COL*9+1,ROW*9+1),YELLOWBOX' Reset Block (XOR).
  76. 76 T=T-FNEXC(COL)
  77. 77 GOSUB 204' Put cursor there.
  78. 78 GOTO 70'Put in mem. and return.
  79. 79 ' F3 Sub. Fill grid.
  80. 80 K=255' All dots on.
  81. 81 FOR ROW=0 TO 7
  82. 82 POKE FNGC(GN,ROW),K
  83. 83 NEXT
  84. 84 RETURN 277
  85. 85 ' F4 Sub. Clear grid.
  86. 86 K=0' All dots off.
  87. 87 GOTO 81' Use fill routine.
  88. 88 ' F5 Sub. Fill Current column.
  89. 89 FOR ROW=0 TO 7
  90. 90 P=PEEK(FNGC(GN,ROW))
  91. 91 IF (P AND FNEXC(COL)) THEN 94
  92. 92 P=P+FNEXC(COL)
  93. 93 POKE FNGC(GN,ROW),P
  94. 94 NEXT
  95. 95 GOTO 84
  96. 96 ' F7 Sub. Fill Current Row.
  97. 97 POKE FNGC(GN,ROW),255
  98. 98 GOTO 84
  99. 99 ' F6 Sub. Reset Current Column.
  100. 100 FOR ROW=0 TO 7
  101. 101 P=PEEK (FNGC(GN,ROW))
  102. 102 IF (P AND FNEXC(COL))=0 THEN 105
  103. 103 P=P-FNEXC(COL)
  104. 104 POKE FNGC(GN,ROW),P
  105. 105 NEXT
  106. 106 GOTO 84
  107. 107 ' F8 Sub. Reset Current Row.
  108. 108 POKE FNGC(GN,ROW),0
  109. 109 GOTO 84
  110. 110 ' F9 Sub. Save Set on Disk.
  111. 111 CLS
  112. 112 LOCATE 12,1
  113. 113 INPUT "Enter Filespec ";FS$
  114. 114 IF LEN(FS$)>14 THEN BEEP:GOTO 111
  115. 115 PRINT"Is "Q$FS$Q$" correct (Y/N) ?";
  116. 116 A$=INKEY$:IF A$="" THEN 116
  117. 117 IF A$="Y" OR A$="y" OR A$=CHR$(13) THEN 119
  118. 118 IF A$="N" OR A$="n" OR A$="0" THEN 111 ELSE BEEP:GOTO 116
  119. 119 BSAVE FS$,0,1024
  120. 120 RETURN 249
  121. 121 ' F10 Sub. Select Alternate Menu.
  122. 122 RETURN 124
  123. 123 ' Set up Alternate Menu.
  124. 124 LINE (1,100)-(318,163),0,BF
  125. 125 LOCATE 14,13
  126. 126 PRINT"Alternate Menu"
  127. 127 LOCATE 15,3:PRINT"F1 Main Menu.      F2  Display Set."
  128. 128 LOCATE 16,3:PRINT"F3 Print Set.      F4  End Program."
  129. 129 ' Set up Alternate Menu Keys.
  130. 130 ON KEY (1) GOSUB 140
  131. 131 ON KEY (2) GOSUB 143
  132. 132 ON KEY (3) GOSUB 160
  133. 133 ON KEY (4) GOSUB 190
  134. 134 ' Turn off Keys 5-14.
  135. 135 FOR X=5 TO 14
  136. 136 KEY (X) OFF
  137. 137 NEXT
  138. 138 GOTO 138' Pressing the proper "F" key will break this loop.
  139. 139 ' F1 Sub. Return to Main Menu.
  140. 140 GOSUB 45' Restore Main Key Vectors.
  141. 141 RETURN 264
  142. 142 ' F2 Sub. Display Set on CRT.
  143. 143 CLS
  144. 144 FOR X=128 TO 255 STEP 3
  145. 145 FOR Y=0 TO 2
  146. 146 IF X+Y>255 THEN 148
  147. 147 PRINT"#";:PRINT USING "### = "+Q$+"!"+Q$+" ";X+Y;CHR$(X+Y);
  148. 148 NEXT:PRINT
  149. 149 IF X<>191 THEN 153
  150. 150 PRINT"Press any key to continue..."
  151. 151 A$=INKEY$
  152. 152 IF A$=""THEN 151
  153. 153 NEXT
  154. 154 PRINT"Press any key to continue..."
  155. 155 A$=INKEY$
  156. 156 IF A$="" THEN 155
  157. 157 CLS
  158. 158 GOTO 140
  159. 159 '
  160. 160 ' F3 Sub. Display Character Set on Printer.
  161. 161 ' This routine will function only
  162. 162 ' with an IBM or EPSON (MX-80 or 100)
  163. 163 ' equipped with the GRAFTRAX graphics
  164. 164 ' ROMS!!
  165. 165 ' Also, use this routine only if you
  166. 166 ' have IBM DOS Version 1.10. Version
  167. 167 ' 1.00 has a bug in its printer
  168. 168 ' I/O routine.
  169. 169 LPRINT CHR$(27)"@"' Reset Printer.
  170. 170 FOR X=128 TO 255 STEP 4
  171. 171  FOR Y=0 TO 3
  172. 172   IF Y+X>254 THEN 183
  173. 173   LPRINT "#";:LPRINT USING "### = "+Q$;X+Y;
  174. 174   LPRINT CHR$(27)"K"CHR$(8)CHR$(0);
  175. 175   FOR Z=0 TO 7
  176. 176    BYTE=0
  177. 177    FOR B=0 TO 7
  178. 178     IF PEEK(FNGC(X+Y,B)) AND FNEXC(Z) THEN BYTE=BYTE + FNEXC(B)
  179. 179    NEXT B
  180. 180   LPRINT CHR$(BYTE);
  181. 181   NEXT Z
  182. 182  LPRINT Q$SPACE$(3);
  183. 183  NEXT Y
  184. 184 LPRINT
  185. 185 NEXT X
  186. 186 LPRINT CHR$(12)
  187. 187 CLS
  188. 188 GOTO 140
  189. 189 ' F4 Sub. End Program.
  190. 190 CLS
  191. 191 RETURN 192
  192. 192 ' Turn Key Trapping off.
  193. 193 FOR X=1 TO 14
  194. 194 KEY (X) OFF
  195. 195 NEXT
  196. 196 END
  197. 197 ' Cursor Positioning Subroutines.
  198. 198 ' F11 Sub. Cursor Up.
  199. 199 IF ROW-1<0 THEN RETURN' At top of grid already.
  200. 200 GOSUB 204'XOR Cursor.
  201. 201 ROW=ROW-1'Go Up.
  202. 202 ' This Sub. erases cursor, if there,
  203. 203 ' or sets it, if not there.
  204. 204 PUT (COL*9+1,ROW*9+1),REDBOX
  205. 205 X=RND*6
  206. 206 PLAY"MBMSL64O=X;T255A"' Just for the fun of it.
  207. 207 RETURN
  208. 208 ' F12 Sub. Cursor Left.
  209. 209 IF COL-1<0 THEN RETURN' Already at left side of grid.
  210. 210 GOSUB 204' XOR Current cursor.
  211. 211 COL=COL-1' Go left.
  212. 212 GOTO 204' Set Cursor.
  213. 213 ' F13 Sub. Cursor Right.
  214. 214 IF COL+1>7 THEN RETURN
  215. 215 GOSUB 204
  216. 216 COL=COL+1
  217. 217 GOTO 204
  218. 218 ' F14 Sub. Cursor Down.
  219. 219 IF ROW+1>7 THEN RETURN
  220. 220 GOSUB 204
  221. 221 ROW=ROW+1
  222. 222 GOTO 204
  223. 223 'Point graphics vector to area just
  224. 224 'above BASICA in a 128K system.
  225. 225 DEF SEG=0' Point to Bottom of RAM.
  226. 226 POKE 124,0
  227. 227 POKE 125,0
  228. 228 POKE 126,PEEK(&H510)+1
  229. 229 POKE 127,PEEK(&H511)+16
  230. 230 'The vector at 0000:0510H-0511H points to the start of BASICA's
  231. 231 '64K segment.
  232. 232 '
  233. 233 'Point to Graphics table 64K+1 bytes
  234. 234 'above beginning of BASICA.
  235. 235 DEF SEG=256*PEEK(127)+PEEK(126)
  236. 236 CLS
  237. 237 LOCATE 12,1
  238. 238 PRINT"Do you want to load a previously saved"
  239. 239 PRINT"character set (Y/N) ?"
  240. 240 A$=INKEY$:IF A$="" THEN 240
  241. 241 IF A$="N" OR A$="n" OR A$="0" THEN 249
  242. 242 IF A$<>CHR$(13) AND A$<>"Y" AND A$<>"y" THEN BEEP:GOTO 240
  243. 243 INPUT "Enter filespec ";FS$
  244. 244 ON ERROR GOTO 246'Trap "File not found" error. ERR=53.
  245. 245 GOTO 248
  246. 246 IF ERR=53 THEN PRINT Q$FS$Q$" was not found.":BEEP:RESUME 243
  247. 247 ON ERROR GOTO 0' Crash if any other error.
  248. 248 BLOAD FS$,0
  249. 249 CLS
  250. 250 LOCATE 12,1
  251. 251 PRINT"Last Character number generated ="GN
  252. 252 X=GN
  253. 253 PRINT "Enter Character number to"
  254. 254 INPUT "generate (128-255)(EN=Next) ";GN
  255. 255 IF GN=0 THEN GN=X+1
  256. 256 IF GN<128 THEN GN=128
  257. 257 IF GN>255 THEN GN=255
  258. 258 IF GN<>255 THEN 263
  259. 259 PRINT
  260. 260 PRINT"CHR$(255) is always null and cannot be"
  261. 261 PRINT"modified."
  262. 262 GOTO 253
  263. 263 CLS
  264. 264 LOCATE 14,1
  265. 265 LINE (1,100)-(318,163),0,BF
  266. 266 LOCATE 14,3:PRINT"Use Arrow Keys to move Cursor."
  267. 267 LOCATE 15,3:PRINT"F1 Sets Dot.    F2  Resets Dot."
  268. 268 LOCATE 16,3:PRINT"F3 Fills Grid.  F4  Clears Grid."
  269. 269 LOCATE 17,3:PRINT"F5 Fills Col.   F6  Clears Col."
  270. 270 LOCATE 18,3:PRINT"F7 Fills Row.   F8  Clears Row."
  271. 271 LOCATE 19,3:PRINT"F9 Saves Set.   F10 Alternate Menu."
  272. 272 LOCATE 20,3:PRINT"Press Enter to Accept Character."
  273. 273 LINE (0,99)-(319,164),2,B
  274. 274 FOR X=0 TO 7
  275. 275 LINE(73,X*9+4)-(152,X*8+3),2
  276. 276 NEXT
  277. 277 PUT (0,0),GRID,PSET' Overwrite the existing grid.
  278. 278 FOR ROW=0 TO 7
  279. 279 P=PEEK(FNGC(GN,ROW))
  280. 280 IF P=0 THEN 284' Skip a blank row.
  281. 281 FOR COL=0 TO 7
  282. 282 IF P AND FNEXC(COL) THEN GOSUB 204:PUT(COL*9+1,ROW*9+1),YELLOWBOX
  283. 283 NEXT
  284. 284 NEXT
  285. 285 ROW=0
  286. 286 COL=0
  287. 287 PUT(1,1),REDBOX
  288. 288 GOTO 294
  289. 289 ROW=0
  290. 290 COL=0
  291. 291 PUT (0,0),GRID
  292. 292 PUT (1,1),REDBOX
  293. 293 REM *** Main Strobe Loop ***
  294. 294 LOCATE 12,1
  295. 295 PRINT"CHR$("RIGHT$(STR$(GN),3)") = "Q$CHR$(GN)Q$" ";
  296. 296 PRINT"STRING$(5,"RIGHT$(STR$(GN),3)") = "Q$STRING$(5,GN)Q$;
  297. 297 A$=INKEY$
  298. 298 IF A$=CHR$(13) THEN 249' "Enter" key? Get a new Character if so.
  299. 299 FOR X=0 TO 7
  300. 300 LOCATE X+1,20
  301. 301 PRINT"Byte"X"= "RIGHT$("0"+HEX$(PEEK(FNGC(GN,X))),2)
  302. 302 NEXT
  303. 303 GOTO 294
  304. 304 END ' of program.
  305.  
  306.  
  307.